COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003	! ALPRIN
C00017 00004	! pvdo & pvldo
C00020 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC

    ENTRY;

BEGIN  "ALPRIN"

IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING="FALSE"; ENDC
IFCR ¬ CREFFING THENC
    REQUIRE "ALREQ.HDR[AL,HE]" SOURCE_FILE;
ENDC
REDEFINE $$PRGID "[]" = ["ALPRIN"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
ENDC


INTERNAL INTEGER PSPCIX;INITIALIZE(PSPCIX←0);

INTERNAL SIMPLE PROCEDURE PRCRLF;
    PRINT(CRLF,("                      "
	       &"                      ")[1 FOR PSPCIX]);


INTERNAL SIMPLE STRING PROCEDURE CVRAD(REAL W);
    RETURN(CVF(W/180)&"*π");

INTERNAL SIMPLE STRING PROCEDURE CVDEG(REAL W);
    RETURN(CVF(W)&"*DEG");

INTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
    RETURN(TBLKSUPPRESS(CVG(R)));

STRING PROCEDURE LBLID(RPTR(LBLVAR) LBL);
    RETURN(IF LBL=NULL_RECORD THEN "<nameless>" ELSE LBLVAR:NAME[LBL]);

! ALPRIN;

INTERNAL RECURSIVE PROCEDURE ALPRIN(RANY S);
    BEGIN "ALPRIN"
    LABEL REPRINT,XIT,HALPR2,HALPR3;
    INTEGER ST;
    RCELL C;

    RECURSIVE PROCEDURE HPFIN(RCELL C);
	BEGIN
	PSPCIX ← PSPCIX+1;
	WHILE C ≠ RNULL DO ALPRIN(LLOP(C));
	PRCRLF;
	PSPCIX ← PSPCIX-1;
	END;

REPRINT:
    ST ← RECTYPE(S);

    IF ST=LOC(SVAL) THEN PRINT(SVAL:VAL[S])
    ELSE IF ST=LOC(V3ECT) THEN
	BEGIN
	BOOLEAN PROCEDURE VPRINT(RPTR(V3ECT) V,NV; STRING ID);
	    BEGIN
	    RANY SS; ! because of SAIL dryrot;
	    SS ← S;
	    IF V3DIST(SS,V)=0 THEN PRINT(" "&ID)
	    ELSE IF V3DIST(SS,NV)=0 THEN PRINT("-"&ID)
	    ELSE RETURN(FALSE);
	    RETURN(TRUE)
	    END;
	IF ¬VPRINT(NILVECT,NILVECT,"NILVECT") ∧
	   ¬VPRINT(XHAT,NEGXHAT,"XHAT") ∧
	   ¬VPRINT(YHAT,NEGYHAT,"YHAT") ∧
	   ¬VPRINT(ZHAT,NEGZHAT,"ZHAT") THEN
		    PRINT(" VECTOR(", CVGX(V3ECT:X[S]),",",
			 CVGX(V3ECT:Y[S]),",",CVGX(V3ECT:Z[S]),")" )
	END
    ELSE IF ST=LOC(ROTN) THEN
	BEGIN
	IF S=NILROTN THEN PRINT(" NILROTN")
	ELSE
	    BEGIN
	    PRINT(" ROTN( ");
	    ALPRIN(ROTN:AXIS[S]);
	    PRINT(",",CVDEG(ROTN:MAGN[S]),")")
	    END
	END
    ELSE IF ST=LOC(TRANS) THEN
	BEGIN
	IF S=NILTRANS THEN PRINT(" NILTRANS")
	ELSE
	    BEGIN
	    PRINT(" TRANS(");
	    ALPRIN(TRANS:R[S]);
	    PRINT(",");
	    ALPRIN(TRANS:P[S]);
	    PRINT(")")
	    END
	END
    ELSE IF ST=LOC(FRAME) THEN
	BEGIN
	IF S=STATION THEN PRINT(" STATION")
	ELSE BEGIN
	    PRINT(" FRAME(");
	    ALPRIN(TRANS:R[FRAME:VAL[S]]);
	    PRINT(",");
	    ALPRIN(TRANS:P[FRAME:VAL[S]]);
	    PRINT(")")
	    END
	END
    ELSE IF ST=LOC(VARIABLE) THEN PRINT(" ",VARIABLE:NAME[S])
    ELSE IF ST=LOC(ARRAYDEF) THEN PRINT(" ",ARRAYDEF:NAME[S])
    ELSE IF ST=LOC(PROCDEF) THEN PRINT(" ",PROCDEF:NAME[S])
    ELSE IF ST=LOC(STCONST) THEN PRINT(" ",STCONST:VAL[S])
    ELSE IF ST=LOC(EXPRN) THEN
	BEGIN
	PRINT("(",OP_MNE[EXPRN:OP[S]]);
	C ← EXPRN:ARGS[S];
	WHILE C ≠ RNULL DO ALPRIN(LLOP(C));
	PRINT(")")
	END
    ELSE IF ST=LOC(STMNT) THEN ALPRIN(STMNT:SEMANTICS[S])
    ELSE IF ST=LOC(CELL) THEN
	BEGIN
	PRINT("(");
	WHILE S ≠ RNULL DO
	    BEGIN
	    ALPRIN(CELL:CAR[S]);
	    S←CELL:CDR[S]
	    END;
	PRINT(" )")
	END
    ELSE IF ST=0 THEN PRINT(" NULL_RECORD ")
    ELSE IF ST=LOC(CMON) THEN
	BEGIN
	IF ¬CMON:FLAGS[S] THEN PRINT(" (ON ") ELSE PRINT(" (DEFER ON ");
	ALPRIN(CMON:CONDITION[S]);
	PRINT(" DO ");
	ALPRIN(CMON:CONCLUSION[S]);
	PRINT(" )")
	END
    ELSE IF ST=LOC(ERROR) THEN
	BEGIN
	PRINT(" (ON ERROR = ");
	ALPRIN(ERROR:BITS[S]);
	PRINT(" DO ");
	ALPRIN(ERROR:BODY[S]);
	PRINT(" )")
	END
    ELSE IF ST = LOC(EVDO) THEN
	BEGIN
	PRCRLF;
	IF EVDO:OP[S] = 0
	THEN PRINT("(SIGNAL ")
	ELSE PRINT("(WAIT ");
	ALPRIN(EVDO:VAR[S]);
	PRINT(")")
	END
    ELSE
	BEGIN
	GO TO HALPR2;
	    ! this admittedly ugly goto statement is here
	      because otherwise you have to use a bigger
	      parse stack in compiling this program, which
	      is a real pain. ;
	END;
    GO TO XIT; ! see the remark immediately above;
HALPR2: IF ST = LOC(CMABLE) THEN
	BEGIN
	PRCRLF;
	IF CMABLE:FLAG[S] THEN PRINT("(DISABLE ") ELSE PRINT("(ENABLE ");
	IF RECTYPE(CMABLE:WHAT[S]) = LOC(LBLVAR) THEN
		PRINT(LBLVAR:NAME[CMABLE:WHAT[S]]);
	PRINT(")")
	END
    ELSE
	BEGIN
	PRCRLF;
	PRINT("(",CVRTS(ST));
	IF ST=LOC(BLOCK) ∨ ST=LOC(COBLOCK) THEN
	    BEGIN
	    IF ST=LOC(BLOCK)
		THEN BEGIN
		C ← BLOCK:VARS[S];
		HPFIN(C);
		C ← BLOCK:CODE[S]
		END
	    ELSE IF ST=LOC(COBLOCK) THEN C ← COBLOCK:CODE[S];
	    HPFIN(C)
	    END
	ELSE IF ST=LOC(PROG) THEN ALPRIN(PROG:CODE[S])
	ELSE IF ST=LOC(ASSIGNMENT) THEN
	    BEGIN
	    ALPRIN(ASSIGNMENT:VAR[S]);
	    PRINT(" ");
	    ALPRIN(ASSIGNMENT:VAL[S])
	    END
	ELSE IF ST=LOC(PAS) THEN
	    BEGIN
	    ALPRIN(PAS:VAR[S]);
	    PRINT(" ");
	    ALPRIN(PAS:VAL[S])
	    END
	ELSE IF ST=LOC(DEPROACH) THEN
	    BEGIN
	    ALPRIN(DEPROACH:VAR[S]);
	    PRINT(" ");
	    ALPRIN(DEPROACH:VAL[S])
	    END
	ELSE IF ST=LOC(MOVE$) THEN
	    BEGIN
	    ALPRIN(MOVE$:WHAT[S]);
	    PRINT(" TO ");
	    ALPRIN(MOVE$:DEST[S]);
	    IF MOVE$:CLAUSES[S] ≠ RNULL THEN
		BEGIN
		PSPCIX ← PSPCIX+1;
		HPFIN(MOVE$:CLAUSES[S]);
		PSPCIX ← PSPCIX-1
		END
	    END
	ELSE IF ST=LOC(OPERATE) THEN
	    BEGIN
	    ALPRIN(OPERATE:WHAT[S]);
	    PRINT(" TO ");
	    ALPRIN(OPERATE:DEST[S]);
	    IF OPERATE:CLAUSES[S] ≠ RNULL THEN
		BEGIN
		PSPCIX ← PSPCIX+1;
		HPFIN(OPERATE:CLAUSES[S]);
		PSPCIX ← PSPCIX-1
		END
	    END
	ELSE IF ST=LOC(CENTER) THEN ALPRIN(CENTER:CF[S])
	ELSE IF ST=LOC(PVL) THEN ALPRIN(PVL:VL[S])
	ELSE IF ST=LOC(IFF) THEN
	    BEGIN
	    ALPRIN(IFF:COND[S]);
	    PSPCIX ← PSPCIX+1;
	    ALPRIN(IFF:THN[S]);
	    ALPRIN(IFF:ELS[S]);
	    PRCRLF;
	    PSPCIX ← PSPCIX-1
	    END
	ELSE IF ST = LOC(WHIL) THEN
	    BEGIN
	    ALPRIN(WHIL:COND[S]);
	    PSPCIX ← PSPCIX+1;
	    PRCRLF;
	    ALPRIN(WHIL:BODY[S]);
	    PSPCIX ← PSPCIX-1;
	    END
	ELSE IF ST = LOC(UNTL) THEN
	    BEGIN
	    PSPCIX ← PSPCIX+1;
	    ALPRIN(UNTL:BODY[S]);
	    PRCRLF;
	    PSPCIX ← PSPCIX-1;
	    ALPRIN(UNTL:COND[S])
	    END
	ELSE IF ST = LOC(KASE) THEN
	    BEGIN
	    ALPRIN(KASE:INDEX[S]);
	    PSPCIX ← PSPCIX+1;
	    PRCRLF;
	    ALPRIN(KASE:STMNTS[S]);
	    PSPCIX ← PSPCIX-1
	    END
	ELSE IF ST = LOC(VIA) THEN
	    BEGIN "via"
	    ALPRIN(VIA:PLACE[S]);
	    IF VIA:VELOC[S] ≠ RNULL THEN ALPRIN(VIA:VELOC[S]);
	    IF VIA:TIME[S] ≠ RNULL THEN ALPRIN(VIA:TIME[S]);
	    IF VIA:CODE[S] ≠ RNULL THEN 
		IF RECTYPE(VIA:CODE[S])=LOC(CMON)
		    THEN ALPRIN(CMON:CONCLUSION[VIA:CODE[S]])
		    ELSE ALPRIN(VIA:CODE[S])
	    END "via"
	ELSE IF ST = LOC(DURATION) THEN
	    BEGIN "duration"
	    PRINT(CASE DURATION:TIME_RELN[S] OF (" ? "," > "," < "," = "));
	    ALPRIN(DURATION:TIME[S])
	    END "duration"
	ELSE IF ST = LOC(VELOCITY) THEN ALPRIN(VELOCITY:VELOC[S])
	ELSE GOTO HALPR3;
	PRINT(")");
	GOTO XIT;

HALPR3: IF ST = LOC(OPENING) THEN ALPRIN(OPENING:VAL[S])
	ELSE IF ST = LOC(APPROACH) THEN ALPRIN(APPROACH:THRU[S])
	ELSE IF ST = LOC(DEPARTURE) THEN ALPRIN(DEPARTURE:THRU[S])
	ELSE IF ST = LOC(FORCE) THEN
	    BEGIN
	    PRINT(IF FORCE:REL[S] = SIGLT THEN " < " ELSE " ≥ ");
	    ALPRIN(FORCE:VAL[S]);
	    PRINT(IF FORCE:TYPE[S] THEN " ALONG " ELSE " ABOUT ");
	    ALPRIN(FORCE:DIRECT[S]);
	    IF FORCE:F_F[S] ≠ RNULL THEN
		BEGIN
		PRINT( " OF ");
		ALPRIN(F_FRAME:FRAME[FORCE:F_F[S]]);
		PRINT( " IN ");
		PRINT(IF F_FRAME:C_SYS[FORCE:F_F[S]]=FHAND THEN " HAND"
		    ELSE " TABLE ")
		END
	    END
	ELSE IF ST = LOC(F_FRAME) THEN
	    BEGIN
	    ALPRIN(F_FRAME:FRAME[S]);
	    PRINT(IF F_FRAME:C_SYS[S] = FTABLE THEN " TABLE " ELSE " HAND ")
	    END
	ELSE IF ST = LOC(WOBBLE) THEN ALPRIN(WOBBLE:VAL[S])
	ELSE IF ST = LOC(S_FAC) THEN ALPRIN(S_FAC:VAL[S])
	ELSE IF ST = LOC(ABORT) THEN ALPRIN(ABORT:VAL[S])
	ELSE IF ST = LOC(STOP) THEN ALPRIN(STOP:CF[S])
	ELSE IF ST = LOC(PAUSE) THEN ALPRIN(PAUSE:VAL[S])
	ELSE IF ST = LOC(PROMPT) THEN ALPRIN(PROMPT:VAL[S])
	ELSE IF ST = LOC(PRNT) THEN ALPRIN(PRNT:VAL[S])
	ELSE IF ST = LOC(NOTE) THEN ALPRIN(NOTE:HESAYS[S])
	ELSE IF ST = LOC(NOTE1) THEN ALPRIN(NOTE1:HESAYS[S])
	ELSE IF ST = LOC(NOTE2) THEN ALPRIN(NOTE2:HESAYS[S])
	ELSE RECPRN(S);
	PRINT(")");
	END;
XIT:    RETURN
    END "ALPRIN";

PROCEDURE INIPFS;
    BEGIN
    INTEGER HPL;
    HPL←LOC(ALPRIN);
    SETRPM(LOC(FRAME),HPL);
    SETRPM(LOC(TRANS),HPL);
    SETRPM(LOC(ROTN),HPL);
    SETRPM(LOC(STMNT),HPL);
    SETRPM(LOC(BLOCK),HPL);
    SETRPM(LOC(VARIABLE),HPL);
    SETRPM(LOC(EXPRN),HPL)
    END;

REQUIRE INIPFS INITIALIZATION;
! pvdo & pvldo;

INTERNAL PROCEDURE PVDO(RPTR(VARIABLE) V; RTHREAD WLD);
    BEGIN

    ! prints out a "pretty" version of the graph node
    for variable VAR in world WLD.;

    RPTR(VNODE) GN;
    RPTR(CALC) C;

    PRCRLF;
    PRINT(VARIABLE:NAME[V], " HAS GRAPH PROPERTIES:");
    PSPCIX ← PSPCIX+10;
    PRCRLF;
    PRCRLF;
    PRINT("VALUE =");
    GETVALUE(V,WLD,TRUE);		! Try to get a value for it;
    GN ← VARIABLE:PLNVAL[V];
    IF GN = RNULL ∨ VNODE:INVMARK[GN] ≠ 0 THEN PRINT(" undefined ")
					  ELSE ALPRIN(VNODE:VAL[GN]);
    GN ← VARIABLE:DEPR[V];		! See if it has a deproach;
    IF GN ≠ RNULL ∧ VNODE:INVMARK[GN] = 0 THEN 
	BEGIN
	PRCRLF;
	PRCRLF;
	PRINT("DEPROACH =");
	ALPRIN(VNODE:VAL[GN])
	END;
    PSPCIX ← PSPCIX-10;
    PRCRLF;
    C ← VARIABLE:CALCS[V];
    IF C ≠ RNULL THEN		! Print out who we're affixed to;
	BEGIN
	PRCRLF;
	PSPCIX ← PSPCIX+10;
	PRINT("AFFIXED TO:");
	PSPCIX ← PSPCIX+5;
	WHILE C ≠ RNULL DO
	    BEGIN
	    PRCRLF;
	    PRINT(VARIABLE:NAME[CALC:OTHER[C]]);
	    IF CALC:TYPE[C] LOR 1 THEN PRINT(" RIGIDLY ")
				  ELSE PRINT(" NON-RIGIDLY ");
	    IF VARIABLE:NAME[CALC:BVAR[C]] ≠ NULL THEN
		PRINT(" BY ",VARIABLE:NAME[CALC:BVAR[C]]);
	    C ← CALC:NXTCALC[C]
	    END;
	PSPCIX ← PSPCIX-15;
	PRCRLF
	END
    END;

INTERNAL PROCEDURE PVLDO(RCELL C; RTHREAD WLD);
    WHILE C ≠ RNULL DO 
	BEGIN
	PVDO(CHKREC(CELL:CAR[C],LOC(VARIABLE)),WLD);
	C ← CELL:CDR[C]
	END;

END $$PRGID;